; ORIGINAL: 3dt2.1/examples/walk.scm
; $Id: walk.scm,v 1.4 1997/04/30 20:24:25 jread Exp $
;----------------------------------------------------------------------
; Purpose---
;    Walk through a model
;
;----------------------------------------------------------------------

(require 'acis "acis.scm")
(require 'old-rb "old-rb.scm")

(define delta-angle .25)
(define step-length 3)

(define (walk onoff)
  (let ((button 0)
        (last-x 0)
        (last-y 0)
        )
    (if onoff
        (begin

          (set! mouse-down-hook (lambda(pe)
                                  (dl:dynamic-silhouette-display #f)
                                  (set! button (event:button pe))
                                  (set! last-x (event:x pe))
                                  (set! last-y (event:y pe))
                                  ))
          (set! mouse-up-hook (lambda(pe)
                                (dl:dynamic-silhouette-display #t) (view:refresh)
                                (set! button 0)
                                ))

          (set! rb-update-hook
                (let ((eye-position (view:eye))
                      (eye-direction (gvector:unitize
                                      (gvector:from-to (view:eye)
                                                       (view:target))))
                      (eye-distance (position:distance (view:eye)
                                                       (view:target)))
                      )
                  (let (
                        (move-eye
                         (lambda (dy)
                           (set! eye-position
                                 (position:offset eye-position
                                                  (gvector:scale
                                                   eye-direction
                                                   (* dy step-length))))))
                        (rotate-eye
                         (lambda (dx)
                           (set! eye-direction
                                 (gvector:transform
                                  eye-direction
                                  (transform:rotation (position 0 0 0)
                                                      (view:up)
                                                      (* dx delta-angle))))))
                        (pan-eye
                         (lambda (dx dy)
                           (let* ((y-dir (view:up))
                                  (x-dir (gvector:cross y-dir eye-direction))
                                  (dir (gvector:+
                                        (gvector:scale x-dir (* dx step-length))
                                        (gvector:scale y-dir (* dy step-length))
                                        ))
                                  )
                             (set! eye-position (position:offset
                                                 eye-position dir))
                             )))
                        (update-view (lambda (pt dir)
                                       (view:set pt
                                                 (position:offset
                                                  pt
                                                  (gvector:scale dir
                                                                 eye-distance))
                                                 (view:up))
                                       (view:refresh)))
                        )
                    (lambda (pe)
                      (let ((x (event:x pe))
                            (y (event:y pe))
                            )
                        (let ((dx (- last-x x))
                              (dy (- last-y y))
                              )
                          (cond
                           ((= button 1)
                            (rotate-eye dx) (move-eye dy)
                            (update-view eye-position eye-direction)
                            )
                           ((> button 1)
                            (pan-eye dx dy)
                            (update-view eye-position eye-direction)
                            )))
                        (set! last-x x)
                        (set! last-y y)
                        )))))
          (view:set-perspective ON)
          (rb:scheme ON)
          )
        (begin
          (set! mouse-down-hook '())
          (set! mouse-up-hook '())
          (set! rb-update-hook '())
          (rb:scheme OFF)
          )
        )))

